unit uDemo;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  Vcl.ComCtrls,
   
  GLS.Objects,
  GLS.Scene,
  GLS.GeomObjects,
  GLS.Coordinates,
  GLS.SimpleNavigation,
  GLS.Material,
  GLS.Cadencer,
  GLS.SceneViewer,
  
  GLS.BaseClasses,
  GLS.SkyDome,
  GLS.RenderContextInfo,
  GLS.FileDDS,
  GLS.VectorTypes,
  GLS.VectorGeometry,
  GLS.Color,
  GLS.State,
  GLS.MaterialEx;


type

  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCadencer1: TGLCadencer;
    GLMaterialLibraryEx1: TGLMaterialLibraryEx;
    GLSimpleNavigation1: TGLSimpleNavigation;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLTorus1: TGLTorus;
    GLPlane1: TGLPlane;
    GLEarthSkyDome1: TGLEarthSkyDome;
    GLSphere1: TGLSphere;
    ComboBox1: TComboBox;
    CheckBox1: TCheckBox;
    UpDown1: TUpDown;
    Edit1: TEdit;
    GLCapsule1: TGLCapsule;
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure FormCreate(Sender: TObject);
    procedure Floor_Material_SM3_Init(
      Sender: TGLBaseShaderModel);
    procedure Torus_Material_SM3_Init(
      Sender: TGLBaseShaderModel);
    procedure Floor_Material_SM4_Init(Sender: TGLBaseShaderModel);
    procedure Torus_Material_SM4_Init(Sender: TGLBaseShaderModel);
    procedure Floor_Material_SM5Init(Sender: TGLBaseShaderModel);
    procedure Floor_Material_SM5_Setting(Sender: TGLBaseShaderModel;
      var ARci: TGLRenderContextInfo);
    procedure Torus_Material_SM5_Init(Sender: TGLBaseShaderModel);
    procedure Torus_Material_SM5_Setting(Sender: TGLBaseShaderModel;
      var ARci: TGLRenderContextInfo);
    procedure ComboBox1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
    procedure Torus_Material_SM4_NextPass_Init(Sender: TGLBaseShaderModel);
  private
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


const
  DesiredTriangleSize = 10.0;

var
  TessellationFactorEdges: Single = 7.0;
  TessellationFactorInside: Single = 7.0;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Drawing sky dome latest with depth test reduce pixels overdraw
  GLEarthSkyDome1.ExtendedOptions := [esoDepthTest];
  // To remove strange bug with secondary texture coordinate
  GLTorus1.ObjectStyle := [osDirectDraw];
end;

procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
  GLLightSource1.MoveObjectAround(GLPlane1, 0, 10*deltaTime);
  GLSceneViewer1.Invalidate;
end;

procedure TForm1.Floor_Material_SM3_Init(Sender: TGLBaseShaderModel);
begin
  with Sender do
  begin
    Uniforms['BaseTextureRepeat'].vec2 := Vector2fMake(0.125, 0.125);
  end;
end;

procedure TForm1.Torus_Material_SM3_Init(Sender: TGLBaseShaderModel);
begin
  with Sender do
  begin
    Uniforms['BaseTextureRepeat'].vec2 := Vector2fMake(24.0, 2.0);
  end;
end;

procedure TForm1.Floor_Material_SM4_Init(Sender: TGLBaseShaderModel);
begin
  with Sender do
  begin
    Uniforms['BaseTextureRepeat'].vec2 := Vector2fMake(0.125, 0.125);
    Uniforms['POMHeightMapScale'].float := 0.025;
    Uniforms['MinSamples'].int := 10;
    Uniforms['MaxSamples'].int := 50;
  end;
end;

procedure TForm1.Torus_Material_SM4_Init(Sender: TGLBaseShaderModel);
begin
  with Sender do
  begin
    Uniforms['BaseTextureRepeat'].vec2 := Vector2fMake(24.0, 2.0);
    Uniforms['POMHeightMapScale'].float := 0.025;
    Uniforms['MinSamples'].int := 10;
    Uniforms['MaxSamples'].int := 50;
  end;
end;

procedure TForm1.Torus_Material_SM4_NextPass_Init(Sender: TGLBaseShaderModel);
begin
  with Sender do
  begin
    Uniforms['BaseTextureRepeat'].vec2 := Vector2fMake(24.0, 2.0);
    Uniforms['POMHeightMapScale'].float := 0.025;
    UNiforms['ExtrudeFin'].float := 0.01;
  end;
end;

procedure TForm1.Floor_Material_SM5Init(Sender: TGLBaseShaderModel);
begin
  with Sender do
  begin
    Uniforms['BaseTextureRepeat'].vec2 := Vector2fMake(0.125, 0.125);
    Uniforms['DetailTessellationHeightScale'].float := 0.05;
  end;
end;

procedure TForm1.Torus_Material_SM5_Init(Sender: TGLBaseShaderModel);
begin
  with Sender do
  begin
    Uniforms['BaseTextureRepeat'].vec2 := Vector2fMake(24.0, 2.0);
    Uniforms['DetailTessellationHeightScale'].float := 0.05;
  end;
end;

procedure TForm1.Torus_Material_SM5_Setting(Sender: TGLBaseShaderModel; var ARci: TGLRenderContextInfo);
begin
  with Sender do
  begin
    Uniforms['TessellationFactor'].vec4 := VectorMake(
      MaxFloat(TessellationFactorEdges / 2.0, 1),
      MaxFloat(TessellationFactorInside / 2.0, 1),
      TessellationFactorEdges / 4.0,
      1.0 / DesiredTriangleSize);
  end;
end;

procedure TForm1.Floor_Material_SM5_Setting(Sender: TGLBaseShaderModel; var ARci: TGLRenderContextInfo);
begin
  with Sender do
  begin
    Uniforms['TessellationFactor'].vec4 := VectorMake(
      TessellationFactorEdges,
      TessellationFactorInside,
      TessellationFactorEdges / 2.0,
      1.0 / DesiredTriangleSize);
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  mode: TGLPolygonMode;
begin
  if CheckBox1.Checked then
    mode := pmLines
  else
    mode := pmFill;
  GLMaterialLibraryEx1.Materials[0].FixedFunction.PolygonMode := mode;
  GLMaterialLibraryEx1.Materials[1].FixedFunction.PolygonMode := mode;
  GLMaterialLibraryEx1.Materials[2].FixedFunction.PolygonMode := mode;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  if ComboBox1.ItemIndex >= 0 then
    GLMaterialLibraryEx1.SetLevelForAll(TGLMaterialLevel(ComboBox1.ItemIndex));
end;

procedure TForm1.UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
begin
  TessellationFactorInside := UpDown1.Position;
  TessellationFactorEdges := TessellationFactorInside;
  Edit1.Text := Format('Tesselation factor: %d', [Round(TessellationFactorInside)]);
end;

end.
